home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / toolbar / databar / psidctb.ba_ / psidctb.ba
Encoding:
Text File  |  1995-03-30  |  6.0 KB  |  211 lines
  1. '
  2. ' Copyright ⌐ 1994-1995, Proficient Solutions Inc.
  3. '
  4. '  Project:     PSIDataBar Support routines
  5. '  Author :     mj
  6. '  Date   :     15 March 1995
  7. '
  8. '  File   :     PSIDCTB.Bas
  9. '  Purpose:     Contains PSIDataBar constants and some useful Windows
  10. '               routines for controlling forms and fields.
  11. '
  12. '  Programmer's Notes:
  13. '
  14. '
  15. Option Explicit
  16.  
  17. ' Toolbar Action commands
  18. Global Const TB_ACTION_ADDNEW = 0
  19. Global Const TB_ACTION_DELETE = 1
  20. Global Const TB_ACTION_UPDATE = 2
  21. Global Const TB_ACTION_UPDATECONTROLS = 3
  22. Global Const TB_ACTION_EDIT = 4
  23. Global Const TB_ACTION_MOVEFIRST = 5
  24. Global Const TB_ACTION_MOVEPREVIOUS = 6
  25. Global Const TB_ACTION_MOVENEXT = 7
  26. Global Const TB_ACTION_MOVELAST = 8
  27. 'Global Const TB_ACTION_MARKRECORD = 9
  28. 'Global Const TB_ACTION_RETURN = 10
  29. 'Global Const TB_ACTION_LASTEDIT = 11
  30.  
  31. Global Const TB_ACTION_INIT = 9
  32.  
  33. ' Border styles
  34. Global Const TB_BORDERNONE = 0
  35. Global Const TB_BORDERSINGLE = 1
  36. Global Const TB_BORDERRAISED = 2
  37. Global Const TB_BORDERLOWERED = 3
  38.  
  39. ' Alignment styles
  40. Global Const TB_ALIGNNONE = 0
  41. Global Const TB_ALIGNTOP = 1
  42. Global Const TB_ALIGNBOTTOM = 2
  43. 'Global Const TB_ALIGNLEFT = 3
  44. 'Global Const TB_ALIGNRIGHT = 4
  45. 'Global Const TB_ALIGNFLOAT = 5
  46.  
  47. ' Toolbar Button indices
  48. Global Const TB_BUTTON_ADDNEW = 0
  49. Global Const TB_BUTTON_DELETE = 1
  50. Global Const TB_BUTTON_UPDATE = 2
  51. Global Const TB_BUTTON_UPDATECONTROLS = 3
  52. Global Const TB_BUTTON_EDIT = 4
  53. Global Const TB_BUTTON_MOVEFIRST = 5
  54. Global Const TB_BUTTON_MOVEPREVIOUS = 6
  55. Global Const TB_BUTTON_MOVENEXT = 7
  56. Global Const TB_BUTTON_MOVELAST = 8
  57. 'Global Const TB_BUTTON_MARKRECORD = 9
  58. 'Global Const TB_BUTTON_RETURN = 10
  59. 'Global Const TB_BUTTON_LASTEDIT = 11
  60.  
  61. ' Useful Windows messages
  62. Declare Function SendMessage Lib "User" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long
  63. Declare Function SetWindowLong Lib "User" (ByVal hWnd As Integer, ByVal nIndex As Integer, ByVal dwNewLong As Long) As Long
  64. Declare Function GetWindowLong Lib "User" (ByVal hWnd As Integer, ByVal nIndex As Integer) As Long
  65. Declare Function SetWindowWord Lib "User" (ByVal hWnd As Integer, ByVal nIndex As Integer, ByVal wNewWord As Integer) As Integer
  66. Declare Function GetWindow Lib "User" (ByVal hWnd As Integer, ByVal wcmd As Integer) As Integer
  67. Declare Function EnableWindow Lib "User" (ByVal hWnd As Integer, ByVal abool As Integer) As Integer
  68.  
  69. ' Things the Window's API really wants (not those weird VB versions)
  70. Global Const WINAPI_TRUE = 1
  71. Global Const WINAPI_FALSE = 0
  72.  
  73. ' Things we ask of and tell a control's window
  74. Global Const WM_USER = &H400
  75. Global Const EM_SetReadOnly = (WM_USER + 31)
  76. Global Const EM_LIMITTEXT = (WM_USER + 21)
  77.  
  78. ' offset to get the window style
  79. Global Const GWL_STYLE = -16
  80.  
  81. ' Used for tweaking the acceptable case for an edit control
  82. Global Const ES_UPPERCASE = &H8&
  83. Global Const ES_LOWERCASE = &H10&
  84.  
  85. '
  86. ' Centers window in its parent
  87. '
  88. Sub CenterWindow (Parent As Form, Child As Form)
  89.     Dim newTop As Integer
  90.     Dim newLeft As Integer
  91.  
  92.     newTop = (Abs(Parent.Height - Child.Height) / 2) + Parent.Top
  93.     newLeft = (Abs(Parent.Width - Child.Width) / 2) + Parent.Left
  94.  
  95.     Child.Move newLeft, newTop
  96. End Sub
  97.  
  98. '
  99. ' Sets a ComboBox control to read-only with a gray background,
  100. ' but keeps the text color "normal"
  101. '
  102. Sub SetComboReadOnly (Ctl As Control)
  103.     Dim l As Long, hWnd As Integer, last As Integer
  104.  
  105.     ' get the first child window of the combo box
  106.     hWnd = GetWindow(Ctl.hWnd, 5)
  107.  
  108.     ' find the last child of the combo box
  109.     ' the last child is the edit control
  110.     ' this appears to be quite a reliable assumption
  111.     Do
  112.         last = hWnd
  113.         hWnd = GetWindow(last, 2)
  114.     Loop Until hWnd = 0
  115.  
  116.     hWnd = last
  117.  
  118.     If hWnd <> 0 Then l = SendMessage(hWnd, EM_SetReadOnly, WINAPI_TRUE, 0&)
  119.  
  120.     ' disable the combo box
  121.     Ctl.Enabled = False
  122.  
  123.     ' enable the edit - get its foreground color back to normal
  124.     If hWnd <> 0 Then hWnd = EnableWindow(hWnd, WINAPI_TRUE)
  125.  
  126.     Ctl.BackColor = &HC0C0C0
  127.  
  128. End Sub
  129.  
  130. '
  131. ' re-enables a combo box and changes its background
  132. ' color back to white
  133. '
  134. Sub SetComboReadWrite (Ctl As Control)
  135.     Dim l As Long, hWnd As Integer, last As Integer
  136.  
  137.     ' get the first child window of the combo box
  138.     hWnd = GetWindow(Ctl.hWnd, 5)
  139.  
  140.     ' find the last child of the combo box
  141.     ' the last child is the edit control
  142.     ' this appears to be quite a reliable assumption
  143.     Do
  144.         last = hWnd
  145.         hWnd = GetWindow(last, 2)
  146.     Loop Until hWnd = 0
  147.  
  148.     hWnd = last
  149.  
  150.     If hWnd <> 0 Then l = SendMessage(hWnd, EM_SetReadOnly, WINAPI_FALSE, 0&)
  151.  
  152.     ' enable combobox
  153.     Ctl.Enabled = True
  154.  
  155.     Ctl.BackColor = &H80000005
  156.  
  157. End Sub
  158.  
  159. '
  160. ' Changes a TextEdit control to read-only and
  161. ' makes the background grey a'la Windows 95
  162. '
  163. Sub SetEditReadOnly (EditCtl As TextBox)
  164.     Dim result As Long
  165.  
  166.     result = SendMessage(EditCtl.hWnd, EM_SetReadOnly, WINAPI_TRUE, 0&)
  167.  
  168.     ' set the back ground to medium gray
  169.     EditCtl.BackColor = &HC0C0C0
  170. End Sub
  171.  
  172. '
  173. ' Changes a TextBox so that it's editable
  174. ' and appears as an action area
  175. '
  176. Sub SetEditReadWrite (EditCtl As TextBox)
  177.     Dim result As Long
  178.  
  179.     result = SendMessage(EditCtl.hWnd, EM_SetReadOnly, WINAPI_FALSE, 0&)
  180.  
  181.     ' set the background to white
  182.     EditCtl.BackColor = &H80000005
  183. End Sub
  184.  
  185. '
  186. ' forces the text in an edit control to be
  187. ' all lowercae
  188. '
  189. Sub SetLowerCaseOnly (EditCtl As TextBox)
  190.     Dim WindowLong As Long
  191.  
  192.     WindowLong = GetWindowLong(EditCtl.hWnd, GWL_STYLE)
  193.     WindowLong = WindowLong Or ES_LOWERCASE
  194.     WindowLong = SetWindowLong(EditCtl.hWnd, GWL_STYLE, WindowLong)
  195.  
  196. End Sub
  197.  
  198. '
  199. ' forces the text in an edit control to be
  200. ' all uppercase
  201. '
  202. Sub SetUpperCaseOnly (EditCtl As TextBox)
  203.     Dim WindowLong As Long
  204.  
  205.     WindowLong = GetWindowLong(EditCtl.hWnd, GWL_STYLE)
  206.     WindowLong = WindowLong Or ES_UPPERCASE
  207.     WindowLong = SetWindowLong(EditCtl.hWnd, GWL_STYLE, WindowLong)
  208.  
  209. End Sub
  210.  
  211.